home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
ada
/
gnat1792.zip
/
gnat179b
/
t-adainc
/
a-strbou.adb
< prev
next >
Wrap
Text File
|
1994-05-19
|
39KB
|
1,254 lines
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- A D A . S T R I N G S . B O U N D E D --
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $ --
-- --
-- Copyright (c) 1992,1993,1994 NYU, All Rights Reserved --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
-- --
------------------------------------------------------------------------------
-- Note: This code is derived from the ADAR.CSH public domain Ada 83
-- versions of the Appendix C string handling packages. Major changes
-- have been made from this starting point. Notably, all use of functions
-- returning strings, and of string concatenation in particular, have been
-- avoided, to make absolutely sure that the heap is not used. The data
-- structure has been simplified to avoid the embedded variant record,
-- which makes it much easier to modify the data of a bounded string
-- in place. Also all dependence on Ada.Strings.Fixed has been removed.
with Ada.Strings.Search;
package body Ada.Strings.Bounded is
package body Generic_Bounded_Length is
---------
-- "=" --
---------
function "=" (Left, Right : in Bounded_String) return Boolean is
begin
return Left.Length = Right.Length
and then Left.Data (1 .. Left.Length) =
Right.Data (1 .. Right.Length);
end "=";
---------
-- "<" --
---------
function "<" (Left, Right : in Bounded_String) return Boolean is
begin
return Left.Data (1 .. Left.Length) < Right.Data (1 .. Right.Length);
end "<";
----------
-- "<=" --
----------
function "<=" (Left, Right : in Bounded_String) return Boolean is
begin
return Left.Data (1 .. Left.Length) <= Right.Data (1 .. Right.Length);
end "<=";
---------
-- ">" --
---------
function ">" (Left, Right : in Bounded_String) return Boolean is
begin
return Left.Data (1 .. Left.Length) > Right.Data (1 .. Right.Length);
end ">";
----------
-- ">=" --
----------
function ">=" (Left, Right : in Bounded_String) return Boolean is
begin
return Left.Data (1 .. Left.Length) >= Right.Data (1 .. Right.Length);
end ">=";
---------
-- "*" --
---------
function "*"
(Left : in Natural;
Right : in Character)
return Bounded_String
is
begin
return Replicate (Left, Right, Strings.Error);
end "*";
function "*"
(Left : in Natural;
Right : in String)
return Bounded_String
is
begin
return Replicate (Left, Right, Strings.Error);
end "*";
function "*"
(Left : in Natural;
Right : in Bounded_String)
return Bounded_String
is
begin
return Replicate (Left, Right, Strings.Error);
end "*";
---------
-- "&" --
---------
function "&" (Left, Right : in Bounded_String)
return Bounded_String is
begin
return Append (Left, Right, Drop => Strings.Error);
end "&";
function "&" (Left : in Bounded_String; Right : in String)
return Bounded_String is
begin
return Append (Left, Right, Drop => Strings.Error);
end "&";
function "&" (Left : in String; Right : in Bounded_String)
return Bounded_String is
begin
return Append (Left, Right, Drop => Strings.Error);
end "&";
function "&" (Left : in Bounded_String; Right : in Character)
return Bounded_String is
begin
return Append (Left, Right, Drop => Strings.Error);
end "&";
function "&" (Left : in Character; Right : in Bounded_String)
return Bounded_String is
begin
return Append (Left, Right, Drop => Strings.Error);
end "&";
------------
-- Append --
------------
-- Case of Bounded_String and Bounded_String
function Append
(Left, Right : in Bounded_String;
Drop : in Strings.Truncation := Strings.Error)
return Bounded_String
is
Result : Bounded_String;
Llen : constant Length_Range := Left.Length;
Rlen : constant Length_Range := Right.Length;
begin
if Llen + Rlen <= Max_Length then
Result.Length := Llen + Rlen;
Result.Data (1 .. Llen) := Left.Data;
Result.Data (Llen + 1 .. Llen + Rlen) := Right.Data;
else
Result.Length := Max_Length;
case Drop is
when Strings.Right =>
if Llen >= Max_Length then
Result.Data (1 .. Max_Length) :=
Left.Data (1 .. Max_Length);
else
Result.Data (1 .. Llen) := Left.Data;
Result.Data (Llen + 1 .. Max_Length) :=
Right.Data (1 .. Max_Length - Llen);
end if;
when Strings.Left =>
if Rlen >= Max_Length then
Result.Data (1 .. Max_Length) :=
Right.Data (Rlen - (Max_Length - 1) .. Rlen);
else
Result.Data (1 .. Max_Length - Rlen) :=
Left.Data (Llen - (Max_Length - Rlen + 1) .. Llen);
Result.Data (Max_Length - Rlen + 1 .. Max_Length) :=
Right.Data;
end if;
when Strings.Error =>
raise Strings.Length_Error;
end case;
end if;
return Result;
end Append;
-- Case of Bounded_String and String
function Append
(Left : in Bounded_String;
Right : in String;
Drop : in Strings.Truncation := Strings.Error)
return Bounded_String
is
Result : Bounded_String;
Llen : constant Length_Range := Left.Length;
Rlen : constant Length_Range := Right'Length;
begin
if Llen + Rlen <= Max_Length then
Result.Length := Llen + Rlen;
Result.Data (1 .. Llen) := Left.Data;
Result.Data (Llen + 1 .. Llen + Rlen) := Right;
else
Result.Length := Max_Length;
case Drop is
when Strings.Right =>
if Llen >= Max_Length then
Result.Data (1 .. Max_Length) :=
Left.Data (1 .. Max_Length);
else
Result.Data (1 .. Llen) := Left.Data;
Result.Data (Llen + 1 .. Max_Length) :=
